home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 14 / CU Amiga Magazine's Super CD-ROM 14 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-09].iso / CUCD / Online / News / Thor / rexx / ChessMaster3000.thor < prev    next >
Encoding:
Text File  |  1996-11-11  |  20.7 KB  |  815 lines
  1. /* ChessMaster3000.thor by Troels Walsted Hansen
  2. ** $VER: ChessMaster3000.thor v1.20 (19.01.95)
  3. **
  4. ** An ARexx script for playing a game of chess against another THOR-
  5. ** user through messages on a BBS. Please refer to the included file
  6. ** ChessMaster3000.doc for detailed information.
  7. */
  8.  
  9. options results
  10.  
  11. /* needs THOR and bbsread.library functions */
  12.  
  13. p = ' ' || address() || ' ' || show('P',,)
  14. thorport = pos(' THOR.',p)
  15.  
  16. if thorport > 0 then thorport = word(substr(p,thorport+1),1)
  17. else
  18. do
  19.     say 'No THOR port found!'
  20.     exit 10
  21. end
  22.  
  23. if ~show('p', 'BBSREAD') then
  24. do
  25.     address command
  26.         "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  27.         "WaitForPort BBSREAD"
  28. end
  29.  
  30. /* save out msgtext and determine whether to continue an old or start a new game */
  31.  
  32. address(thorport)
  33. THORTOFRONT
  34. SAVEMESSAGE CURRENT FILENAME '"T:ChessMaster3000.thor.temp"' NOHEADER NOANSI
  35.  
  36. if ~open(ifh, 'T:ChessMaster3000.thor.temp', R) then
  37. do
  38.     REQUESTNOTIFY TEXT '"Cannot open temporary file: T:ChessMaster3000.thor.temp"' BT '"_Ok"'
  39.     exit
  40. end
  41.  
  42. /*
  43. ***ChessMaster3000, round #1
  44. */
  45.  
  46. newgame = 0
  47. firstmove = 1
  48.  
  49. do until(pos('***ChessMaster3000', line) > 0)
  50.     if eof(ifh) then
  51.     do
  52.         REQUESTNOTIFY TEXT '"Message contains no ChessMaster3000 data!"' BT '"_Ok"'
  53.         REQUESTNOTIFY TEXT '"Start new game?"' BT '"_Yes|_No"'
  54.         if(rc = 0 & result = 1) then
  55.         do
  56.             call close(ifh)
  57.  
  58.             /* initiate variables */
  59.             call NewGame()
  60.  
  61.             firstmove = 1
  62.  
  63.             /* write all the data */
  64.             call WriteData()
  65.  
  66.             address(thorport)
  67.             SHOWTEXT 'T:ChessMaster3000.thor.temp'
  68.  
  69.             /* move first turn */
  70.             call PlayMove()
  71.  
  72.             firstmove = 0
  73.  
  74.             /* write all the data */
  75.             call WriteData()
  76.  
  77.             address(thorport)
  78.             SHOWTEXT 'T:ChessMaster3000.thor.temp'
  79.  
  80.             /* post the file */
  81.             call PostMsg()
  82.             signal exit
  83.         end
  84.         signal exit
  85.     end
  86.     line = readln(ifh)
  87. end
  88.  
  89. firstmove = 0
  90.  
  91. /* read the rest of the chess info */
  92.  
  93. call ReadData()
  94.  
  95. /* move the pieces etc. */
  96.  
  97. call PlayMove()
  98.  
  99. /* write all the data to a file */
  100.  
  101. call WriteData()
  102.  
  103. address(thorport)
  104. SHOWTEXT 'T:ChessMaster3000.thor.temp'
  105.  
  106. /* initiate all variables from message info */
  107.  
  108. address(thorport)
  109. CURRENTMSG stem MSG
  110.  
  111. address(bbsread)
  112. READBRMESSAGE bbsname '"'MSG.BBSNAME'"' confname '"'MSG.CONFNAME'"' msgnr '"'MSG.MSGNR'"' headstem HEAD textstem TEXT
  113.  
  114. EVENT.TYPE            = 1                    /* replymsg */
  115. EVENT.TONAME        = HEAD.FROMNAME
  116. EVENT.SUBJECT        = HEAD.SUBJECT
  117. EVENT.CONFERENCE    = MSG.CONFNAME
  118. EVENT.REFNR            = MSG.MSGNR
  119. EVENT.REFORGINALNR    = HEAD.ORGINALNR
  120.  
  121. /* Not needed?
  122. EVENT.REFID         = HEAD.REFID
  123. EVENT.TOADDR         = TEXT.REPLYADDR
  124. */
  125.  
  126. /* post the file as a reply to the current message */
  127.  
  128. call PostMsg()
  129. signal exit
  130.  
  131. NewGame:
  132.     /* initiate all variables otherwise read from the message text */
  133.  
  134.     roundnumber = 0
  135.     newgame = 1
  136.  
  137.     pos.1.8 = ' #C# '; pos.2.8 = ' #N# '; pos.3.8 = ' #B# '; pos.4.8 = ' #Q# '; pos.5.8 = ' #K# '; pos.6.8 = ' #B# '; pos.7.8 = ' #N# '; pos.8.8 = ' #C# '
  138.     pos.1.7 = ' #P# '; pos.2.7 = ' #P# '; pos.3.7 = ' #P# '; pos.4.7 = ' #P# '; pos.5.7 = ' #P# '; pos.6.7 = ' #P# '; pos.7.7 = ' #P# '; pos.8.7 = ' #P# '
  139.  
  140.     do y=6 to 3 by -1
  141.         do x=1 to 8
  142.             pos.x.y = '   '
  143.         end
  144.     end
  145.  
  146.     pos.1.2 = ' P '; pos.2.2 = ' P '; pos.3.2 = ' P '; pos.4.2 = ' P '; pos.5.2 = ' P '; pos.6.2 = ' P '; pos.7.2 = ' P '; pos.8.2 = ' P '
  147.     pos.1.1 = ' C '; pos.2.1 = ' N '; pos.3.1 = ' B '; pos.4.1 = ' Q '; pos.5.1 = ' K '; pos.6.1 = ' B '; pos.7.1 = ' N '; pos.8.1 = ' C '
  148.  
  149.     blacklosses = ''
  150.     whitelosses = ''
  151.  
  152.     /* initiate all variables otherwise read from the message header data */
  153.  
  154.     EVENT.TYPE = 0 /* entermsg */
  155.  
  156.     address(bbsread)
  157.     GETBBSLIST stem BBSLIST
  158.     if(rc ~= 0) then
  159.     do
  160.         address(thorport)
  161.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  162.         signal exit
  163.     end
  164.  
  165.     address(thorport)
  166.     REQUESTLIST instem BBSLIST title '"Select BBS:"' SIZEGADGET
  167.     if(rc ~= 0) then signal exit
  168.     else MSG.BBSNAME = result
  169.  
  170.     address(bbsread)
  171.     GETCONFLIST '"'MSG.BBSNAME'"' CONFLIST
  172.     if(rc ~= 0) then
  173.     do
  174.         address(thorport)
  175.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  176.         signal exit
  177.     end
  178.  
  179.     address(thorport)
  180.     REQUESTLIST instem CONFLIST title '"Select conf:"' SIZEGADGET
  181.     if(rc ~= 0) then signal exit
  182.     else EVENT.CONFERENCE = result
  183.  
  184.     REQUESTSTRING TITLE '"Please enter subject of message:"' BT '"_Ok|_Cancel"' ID '"ChessMaster3000"' MAXCHARS 100
  185.     EVENT.SUBJECT = result
  186.     if(rc ~= 0 | EVENT.SUBJECT = "") then signal exit
  187.  
  188.     do forever
  189.         REQUESTSTRING TITLE '"Please enter the name of your opponent:"' BT '"_Ok|_Cancel "' MAXCHARS 200
  190.         if(rc ~= 0) then signal exit
  191.         EVENT.TONAME = result
  192.  
  193.         if(upper(EVENT.TONAME) ~= "ALL") then
  194.         do
  195.             address(bbsread)
  196.             SEARCHBRUSER bbsname '"'MSG.BBSNAME'"' stem USERS search '"'EVENT.TONAME'"' name address alias suggestusersstem SUG
  197.             if(rc ~= 0) then signal exit
  198.  
  199.             if(result > 0) then
  200.             do
  201.                 drop LIST.
  202.                 drop USERTAGS.
  203.  
  204.                 LIST.COUNT = USERS.COUNT
  205.  
  206.                 do n = 1 to USERS.COUNT
  207.                     LIST.n.USERNR = USERS.n.USERNR
  208.  
  209.                     address(bbsread)
  210.                     READBRUSER bbsname '"'MSG.BBSNAME'"' usernr USERS.n.USERNR tagsstem USERTAGS
  211.                     if(rc ~= 0) then signal exit
  212.                     LIST.n = USERTAGS.NAME
  213.  
  214.                     if(symbol("USERTAGS.ADDRESS") = "VAR") then
  215.                         LIST.n.ADDRESS = USERTAGS.ADDRESS
  216.                 end
  217.  
  218.                 address(thorport)
  219.                 REQUESTLIST instem LIST title '"Select user:"'
  220.                 if(rc ~= 0) then
  221.                 do
  222.                     if(rc ~= 5) then REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  223.                     signal exit
  224.                 end
  225.  
  226.                 EVENT.TONAME = result
  227.  
  228.                 do n = 1 to LIST.COUNT
  229.                     if(LIST.n = EVENT.TONAME) then
  230.                         EVENT.TOADDR = LIST.n.ADDRESS
  231.                 end
  232.                 leave
  233.             end
  234.             else
  235.             do
  236.                 if(symbol("SUG.COUNT") = "VAR") then do
  237.                     address(thorport)
  238.                     REQUESTLIST instem SUG title '"Select user:"'
  239.                     if(rc ~= 0) then
  240.                     do
  241.                         if(rc ~= 5) then REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  242.                         signal exit
  243.                     end
  244.  
  245.                     EVENT.TONAME = result
  246.  
  247.                     do n = 1 to SUG.COUNT
  248.                         if(SUG.n = EVENT.TONAME) then
  249.                             usernumber = SUG.n.USERNR
  250.                     end
  251.  
  252.                     drop USERTAGS.
  253.  
  254.                     address(bbsread)
  255.                     READBRUSER bbsname '"'MSG.BBSNAME'"' usernr usernumber tagsstem USERTAGS
  256.                     if(rc ~= 0) then signal exit
  257.  
  258.                     if(symbol("USERTAGS.ADDRESS") = "VAR") then
  259.                         EVENT.TOADDR = USERTAGS.ADDRESS
  260.  
  261.                     leave
  262.                 end
  263.                 else
  264.                 do
  265.                     address(thorport)
  266.                     REQUESTNOTIFY TEXT '"No matching users found, try again?"' BT '"_Ok|_Cancel"'
  267.                     if(rc ~= 0) then signal exit
  268.                     if(result = 0) then signal exit
  269.                 end
  270.             end
  271.         end
  272.         else signal exit /* doesn't work with ALL */
  273.     end
  274.  
  275.     blackplayer = EVENT.TONAME
  276. RETURN
  277.  
  278. ReadData:
  279.     roundnumber = substr(line, lastpos('#', line)+1)
  280.  
  281.     /*
  282.  
  283.     Black: Matthias Bartosik
  284.     White: Troels Walsted_Hansen
  285.     */
  286.  
  287.     call readln(ifh)
  288.     blackplayer = substr(readln(ifh), 8)
  289.     whiteplayer = substr(readln(ifh), 8)
  290.  
  291.     /*
  292.  
  293.     Status: White Pawn at H1 exchanged for Bishop
  294.  
  295.          +---+---+---+---+---+---+---+---+
  296.     */
  297.  
  298.     do 4; call readln(ifh); end
  299.  
  300.     /*
  301.        8 | #C# | #N# | #B# | #Q# | #K# | #B# | #N# | #C# |
  302.          +---+-^-+---+-^-+---+-^-+---+-^-+
  303.        7 | #P# | #P# | #P# | #P# | #P# | #P# | #P# | #P# |
  304.          +-^-+---+-^-+---+-^-+---+-^-+---+
  305.        6 |   |   |   |   |   |   |   |   |
  306.          +---+-^-+---+-^-+---+-^-+---+-^-+
  307.        5 |   |   |   |   |   |   |   |   |
  308.          +-^-+---+-^-+---+-^-+---+-^-+---+
  309.        4 |   |   |   |   |   |   |   |   |
  310.          +---+-^-+---+-^-+---+-^-+---+-^-+
  311.        3 |   |   |   |   |   |   |   |   |
  312.          +-^-+---+-^-+---+-^-+---+-^-+---+
  313.        2 | P | P | P | P | P | P | P | P |
  314.          +---+-^-+---+-^-+---+-^-+---+-^-+
  315.        1 | C | N | B | Q | K | B | N | C |
  316.          +-^-+---+-^-+---+-^-+---+-^-+---+
  317.            a   b   c   d   e   f   g   h
  318.  
  319.     Black losses:
  320.     */
  321.  
  322.     line.8 = readln(ifh);        call readln(ifh)
  323.     line.7 = readln(ifh);        call readln(ifh)
  324.     line.6 = readln(ifh);        call readln(ifh)
  325.     line.5 = readln(ifh);        call readln(ifh)
  326.     line.4 = readln(ifh);        call readln(ifh)
  327.     line.3 = readln(ifh);        call readln(ifh)
  328.     line.2 = readln(ifh);        call readln(ifh)
  329.     line.1 = readln(ifh)
  330.  
  331.     do 4; call readln(ifh); end
  332.  
  333.     /*
  334.     #C#, #Q#
  335.  
  336.     White losses:
  337.     B, P, Q
  338.     */
  339.  
  340.     blacklosses = readln(ifh)
  341.     do 2; call readln(ifh); end
  342.     whitelosses = readln(ifh)
  343.  
  344.     call close(ifh)
  345.  
  346.     /* parse the input */
  347.  
  348.     do y=1 to 8
  349.         line.y = delstr(line.y, 1, 6)
  350.  
  351.         do x=1 to 8
  352.             pos.x.y = substr(line.y, 1, pos('|', line.y)-1)
  353.             line.y = delstr(line.y, 1, pos('|', line.y))
  354.         end
  355.     end
  356. RETURN
  357.  
  358. PlayMove:
  359.     /* determine who the current player is */
  360.  
  361.     address(thorport)
  362.     CURRENTBBS stem CURRENT
  363.     if(rc ~= 0) then
  364.     do
  365.         address(thorport)
  366.         REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
  367.         signal exit
  368.     end
  369.  
  370.     address(bbsread)
  371.     GETBBSDATA bbsname '"'CURRENT.BBSNAME'"' stem BBSDATA
  372.     if(rc ~= 0) then
  373.     do
  374.         address(thorport)
  375.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  376.         signal exit
  377.     end
  378.  
  379.     if(BBSDATA.USERNAME = '') then
  380.     do
  381.         GETGLOBALDATA stem GLOBALDATA
  382.             if(rc ~= 0) then
  383.             do
  384.                 address(thorport)
  385.                 REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  386.                 signal exit
  387.             end
  388.  
  389.         if(GLOBALDATA.USERNAME = '') then signal exit
  390.         else username = GLOBALDATA.USERNAME
  391.     end
  392.     else username = BBSDATA.USERNAME
  393.  
  394.     if(newgame) then whiteplayer = username
  395.  
  396.     select
  397.         when(username = blackplayer) then
  398.         do
  399.             color = 'Black'
  400.             othercolor = 'White'
  401.         end
  402.  
  403.         when(username = whiteplayer) then
  404.         do
  405.             color = 'White'
  406.             othercolor = 'Black'
  407.         end
  408.  
  409.         otherwise signal exit
  410.     end
  411.  
  412.     /* ask user to specify move */
  413.  
  414.     exchangepawn = 0
  415.     longcastle = 0
  416.     shortcastle = 0
  417.     passant = 0
  418.  
  419.     address(thorport)
  420.     REQUESTSTRING TITLE '"ChessMaster3000"' BODY '"' || color || ' player enter your move\non the form ''xyxy''.' || '"' BT '"_Ok|_Special move|_Cancel"' MAXCHARS 4
  421.     if(rc ~= 0) then signal exit
  422.  
  423.     /* normal move */
  424.  
  425.     if(result ~= '') then
  426.     do
  427.         origmovestr = upper(result)
  428.  
  429.         movestr = translate(origmovestr, '12345678', 'ABCDEFGH')
  430.  
  431.         fromxpos = substr(movestr, 1, 1);    fromypos = substr(movestr, 2, 1)
  432.         toxpos = substr(movestr, 3, 1);        toypos = substr(movestr, 4, 1)
  433.  
  434.         /* verify the integrity of the coordinates */
  435.  
  436.         select
  437.             when(fromxpos > 8 | fromxpos < 1) then errormsg = 'FROM x-coordinate out of range.'
  438.             when(fromypos > 8 | fromypos < 1) then errormsg = 'FROM y-coordinate out of range.'
  439.             when(toxpos > 8 | toxpos < 1) then errormsg = 'TO x-coordinate out of range.'
  440.             when(toypos > 8 | toypos < 1) then errormsg = 'TO y-coordinate out of range.'
  441.             when(pos.fromxpos.fromypos = '   ') then errormsg = 'Invalid FROM coordinates, no chess piece found.'
  442.             when(left(strip(pos.fromxpos.fromypos, B), 1) = '#' & color = 'White' | left(strip(pos.fromxpos.fromypos, B), 1) ~= '#' & color = 'Black') then errormsg = 'Invalid FROM coordinates, trying to\nmove other player''s chess piece.'
  443.             when(pos.toxpos.toypos ~= '   ' & left(strip(pos.toxpos.toypos, B), 1) ~= '#' & color = 'White' | left(strip(pos.toxpos.toypos, B), 1) = '#' & color = 'Black') then errormsg = 'TO square is occupied by your own piece.'
  444.             otherwise errormsg = ''
  445.         end
  446.  
  447.         if(errormsg ~= '') then
  448.         do
  449.             address(thorport)
  450.             REQUESTNOTIFY TEXT '"'errormsg'"' BT '"_Ok"'
  451.             signal exit
  452.         end
  453.  
  454.         /* determine whether an enemy piece has been beaten */
  455.  
  456.         frompiece = compress(pos.fromxpos.fromypos, '# ')
  457.         topiece = compress(pos.toxpos.toypos, '# ')
  458.  
  459.         if(pos.toxpos.toypos ~= '   ') then
  460.         do
  461.             if(topiece = 'K') then
  462.             do
  463.                 address(thorport)
  464.                 do 50; BEEP; end
  465.                 REQUESTNOTIFY TEXT '"You have won the game!"' BT '"H_ooya!"'
  466.                 /* gotta post a fancy message here */
  467.                 signal exit
  468.             end
  469.  
  470.             if(color = 'Black') then whitelosses = whitelosses || ', ' || strip(pos.toxpos.toypos, B)
  471.             else blacklosses = blacklosses || ', ' || strip(pos.toxpos.toypos, B)
  472.  
  473.             select
  474.                 when(left(blacklosses, 1) = ',') then blacklosses = substr(blacklosses, 3)
  475.                 when(left(whitelosses, 1) = ',') then whitelosses = substr(whitelosses, 3)
  476.                 otherwise nop
  477.             end
  478.         end
  479.         else anyonebeaten = 'FALSE'
  480.  
  481.         /* move the piece to the TO square and clear the FROM square */
  482.  
  483.         pos.toxpos.toypos = pos.fromxpos.fromypos
  484.         pos.fromxpos.fromypos = '   '
  485.     end
  486.     else    /* special move */
  487.     do
  488.         address(thorport)
  489.         REQUESTNOTIFY TEXT '"Select special move:"' BT '"_Exchange Pawn|C_astle|_Passant|_Cancel"'
  490.         if(rc ~= 0) then signal exit
  491.  
  492.         select
  493.             when(result = 0) then signal exit    /* Cancel             */
  494.             when(result = 1) then                /* Exchange Pawn     */
  495.             do
  496.                 exchangepawn = 1
  497.  
  498.                 if(color = 'Black') then y = 1
  499.                 else y = 8
  500.  
  501.                 availpawn.count = 0
  502.  
  503.                 do x=1 to 8
  504.                     if(compress(pos.x.y, '# ') = 'P') then
  505.                     do
  506.                         availpawn.count = availpawn.count+1
  507.                         k = availpawn.count
  508.                         availpawn.k = translate(x, 'ABCDEFGH', '12345678') || y
  509.                     end
  510.                 end
  511.  
  512.                 if(availpawn.count = 0) then
  513.                 do
  514.                     address(thorport)
  515.                     REQUESTNOTIFY TEXT '"No Pawn-exchanging is possible."' BT '"_Ok"'
  516.                     signal exit
  517.                 end
  518.  
  519.                 if(availpawn.count ~= 1) then
  520.                 do
  521.                     /* change to REQUESTNOTIFY !? */
  522.                     address(thorport)
  523.                     REQUESTLIST TITLE '"Choose one set of coordinates"' instem availpawn SIZEGADGET
  524.                     if(rc ~= 0) then signal exit
  525.  
  526.                     pawncoord = result
  527.                 end
  528.                 else pawncoord = availpawn.1
  529.  
  530.                 address(thorport)
  531.                 REQUESTNOTIFY TEXT '"Select new chess piece:"' BT '"_Queen|_Bishop|K_night|_Castle"'
  532.                 if(rc ~= 0) then signal exit
  533.  
  534.                 select
  535.                     when(result = 0) then signal exit
  536.                     when(result = 1) then frompiece = 'Q'
  537.                     when(result = 2) then frompiece = 'B'
  538.                     when(result = 3) then frompiece = 'N'
  539.                     when(result = 4) then frompiece = 'C'
  540.                     otherwise frompiece = 'P'
  541.                 end
  542.  
  543.                 if(color = 'Black') then styledfrompiece = ' #' || frompiece || '# '
  544.                 else styledfrompiece = ' ' || frompiece || ' '
  545.  
  546.                 x = translate(left(pawncoord, 1), '12345678', 'ABCDEFGH')
  547.                 y = right(pawncoord, 1)
  548.  
  549.                 pos.x.y = styledfrompiece
  550.             end
  551.  
  552.             when(result = 2) then        /* Castle            */
  553.             do
  554.                 if(color = 'Black') then y = 8
  555.                 else y = 1
  556.  
  557.                 if(compress(pos.1.y, '# ') = 'C' & pos.2.y = '   ' & pos.3.y = '   ' & pos.4.y = '   ' & compress(pos.5.y, '# ') = 'K') then longcastle = 1
  558.                 if(compress(pos.5.y, '# ') = 'K' & pos.6.y = '   ' & pos.7.y = '   ' & compress(pos.8.y, '# ') = 'C') then shortcastle = 1
  559.  
  560.                 if(longcastle = 0 & shortcastle = 0) then
  561.                 do
  562.                     address(thorport)
  563.                     REQUESTNOTIFY TEXT '"You cannot perform a castling."' BT '"_Ok"'
  564.                     signal exit
  565.                 end
  566.  
  567.                 gadstr = ''
  568.  
  569.                 if(longcastle = 1 & shortcastle = 1) then
  570.                 do
  571.                     address(thorport)
  572.                     REQUESTNOTIFY TEXT '"Select which kind of castling:"' BT '"_Long|_Short|_Cancel"'
  573.                     if(rc ~= 0) then signal exit
  574.  
  575.                     if(result = 1) then shortcastle = 0
  576.                     else longcastle = 0
  577.                 end
  578.  
  579.                 /* style 'em */
  580.  
  581.                 if(color = 'Black') then
  582.                 do
  583.                     styledking = ' #K# '
  584.                     styledcastle = ' #C# '
  585.                 end
  586.                 else
  587.                 do
  588.                     styledking = ' K '
  589.                     styledcastle = ' C '
  590.                 end
  591.  
  592.                 select
  593.                     when(longcastle = 1) then
  594.                     do
  595.                         pos.1.y = '   ';        pos.5.y = '   '
  596.                         pos.3.y = styledking;    pos.4.y = styledcastle
  597.                     end
  598.  
  599.                     when(shortcastle = 1) then
  600.                     do
  601.                         pos.8.y = '   ';        pos.5.y = '   '
  602.                         pos.7.y = styledking;    pos.6.y = styledcastle
  603.                     end
  604.  
  605.                     otherwise signal exit
  606.                 end
  607.             end
  608.  
  609.             when(result = 3) then        /* Passant            */
  610.             do
  611.                 passant = 1
  612.  
  613.                 /* beating 'en passant' may happen only if two opponent pawns are
  614.                    standing next to each other on either y=5 | y=4. */
  615.  
  616.                 if(color  = 'Black') then y = 4
  617.                 else y = 5
  618.  
  619.                 availpassant.count = 0
  620.  
  621.                 do x=1 to 8
  622.                     k = x+1
  623.                     if(pos.x.y = ' P ' & pos.k.y = ' #P# ' | pos.x.y = ' #P# ' & pos.k.y = ' P ') then
  624.                     do
  625.                         /* determine which one belongs to the current player */
  626.                         select
  627.                             when(pos.x.y = ' P ' & color = 'White') then
  628.                             do
  629.                                 passantkillercolor = 'White'
  630.                                 passantvictimcolor = 'Black'
  631.                                 passantkillerx = x
  632.                                 passantvictimx = k
  633.                             end
  634.  
  635.                             when(pos.k.y = ' P ' & color = 'White') then
  636.                             do
  637.                                 passantkillercolor = 'White'
  638.                                 passantvictimcolor = 'Black'
  639.                                 passantkillerx = k
  640.                                 passantvictimx = x
  641.                             end
  642.  
  643.                             when(pos.x.y = ' #P# ' & color = 'Black') then
  644.                             do
  645.                                 passantkillercolor = 'Black'
  646.                                 passantvictimcolor = 'White'
  647.                                 passantkillerx = x
  648.                                 passantvictimx = k
  649.                             end
  650.  
  651.                             when(pos.k.y = ' #P# ' & color = 'Black') then
  652.                             do
  653.                                 passantkillercolor = 'Black'
  654.                                 passantvictimcolor = 'White'
  655.                                 passantkillerx = k
  656.                                 passantvictimx = x
  657.                             end
  658.  
  659.                             otherwise signal exit
  660.                         end
  661.  
  662.                         /* determine whether the appropriate squares are open */
  663.  
  664.                         if(passantkillercolor = 'Black' & pos.passantvictimx.2 = '   ' & pos.passantvictimx.3 = '   ' | passantkillercolor = 'White' & pos.passantvictimx.6 = '   ' & pos.passantvictimx.7 = '   ') then
  665.                         do
  666.                             availpassant.count = availpassant.count+1
  667.                             j = availpassant.count
  668.                             availpassant.j = translate(passantkillerx, 'ABCDEFGH', '12345678') || y || ' beating ' || translate(passantvictimx, 'ABCDEFGH', '12345678') || y
  669.                         end
  670.                     end
  671.                 end
  672.  
  673.                 if(availpassant.count = 0) then
  674.                 do
  675.                     address(thorport)
  676.                     REQUESTNOTIFY TEXT '"No passant opportunities available."' BT '"_Ok"'
  677.                     signal exit
  678.                 end
  679.  
  680.                 if(availpassant.count ~= 1) then
  681.                 do
  682.                     address(thorport)
  683.                     REQUESTLIST TITLE '"Choose one scenario:"' instem availpassant SIZEGADGET
  684.                     if(rc ~= 0) then signal exit
  685.  
  686.                     passantcoord = result
  687.                 end
  688.                 else passantcoord = availpassant.1
  689.  
  690.                 toxpos = translate(substr(passantcoord, 12, 1), '12345678', 'ABCDEFGH')
  691.  
  692.                 if(color = 'Black') then whitelosses = whitelosses || ', ' || strip(pos.toxpos.y, B)
  693.                 else blacklosses = blacklosses || ', ' || strip(pos.toxpos.y, B)
  694.  
  695.                 select
  696.                     when(left(blacklosses, 1) = ',') then blacklosses = substr(blacklosses, 3)
  697.                     when(left(whitelosses, 1) = ',') then whitelosses = substr(whitelosses, 3)
  698.                     otherwise nop
  699.                 end
  700.  
  701.                 /* clear the TO square */
  702.  
  703.                 pos.toxpos.y = '   '
  704.                 passantcoord = right(passantcoord, 2)
  705.             end
  706.  
  707.             otherwise signal exit        /* just in case        */
  708.         end
  709.     end
  710.  
  711.     roundnumber = roundnumber+1
  712. RETURN
  713.  
  714. WriteData:
  715.     /* write the whole thing to a temp file */
  716.  
  717.     call open(ofh, 'T:ChessMaster3000.thor.temp', W)
  718.  
  719.     call writeln(ofh, '***ChessMaster3000, round #' || roundnumber)
  720.     call writeln(ofh, '')
  721.     call writeln(ofh, 'Black: ' || blackplayer)
  722.  
  723.     if(firstmove) then whiteplayer = 'You.'
  724.  
  725.     call writeln(ofh, 'White: ' || whiteplayer)
  726.     call writeln(ofh, '')
  727.  
  728.     select
  729.         when(topiece = 'K') then str = ' King'
  730.         when(topiece = 'Q') then str = ' Queen'
  731.         when(topiece = 'C') then str = ' Castle'
  732.         when(topiece = 'N') then str = ' Knight'
  733.         when(topiece = 'B') then str = ' Bishop'
  734.         when(topiece = 'P') then str = ' Pawn'
  735.         otherwise str = ' Unknown'
  736.     end
  737.  
  738.     if(anyonebeaten ~= 'FALSE') then beatenstr = ' beating ' || othercolor || str
  739.     else beatenstr = ''
  740.  
  741.     select
  742.         when(frompiece = 'K') then str = ' King '
  743.         when(frompiece = 'Q') then str = ' Queen '
  744.         when(frompiece = 'C') then str = ' Castle '
  745.         when(frompiece = 'N') then str = ' Knight '
  746.         when(frompiece = 'B') then str = ' Bishop '
  747.         when(frompiece = 'P') then str = ' Pawn '
  748.         otherwise str = ' Unknown '
  749.     end
  750.  
  751.     select
  752.         when(firstmove)        then     statstr = 'Status: Waiting for your first move.'
  753.         when(exchangepawn)    then    statstr = 'Status: ' || color || ' Pawn at ' || pawncoord || ' exchanged for' || str
  754.         when(longcastle)    then    statstr = 'Status: ' || color || ' performed a long castling'
  755.         when(shortcastle)    then    statstr = 'Status: ' || color || ' performed a short castling'
  756.         when(passant)        then     statstr = 'Status: ' || color || ' Pawn beat a ' || othercolor || ' Pawn en passant at ' || passantcoord
  757.         otherwise                    statstr = 'Status: ' || color || str || 'from ' || left(origmovestr, 2) || ' to ' || right(origmovestr, 2) || beatenstr
  758.     end
  759.  
  760.     call writeln(ofh, statstr)
  761.     call writeln(ofh, '')
  762.     call writeln(ofh, '     +---+---+---+---+---+---+---+---+')
  763.  
  764.     do y=8 to 1 by -1
  765.         call writeln(ofh, '   ' || y || ' |' || pos.1.y || '|' || pos.2.y || '|' || pos.3.y || '|' || pos.4.y || '|' || pos.5.y || '|' || pos.6.y || '|' || pos.7.y || '|' || pos.8.y || '|')
  766.         if(y//2 = 0) then str = '     +---+-^-+---+-^-+---+-^-+---+-^-+'
  767.         else str = '     +-^-+---+-^-+---+-^-+---+-^-+---+'
  768.         call writeln(ofh, str)
  769.     end
  770.  
  771.     call writeln(ofh, '       a   b   c   d   e   f   g   h')
  772.     call writeln(ofh, '')
  773.     call writeln(ofh, 'Black losses:')
  774.     call writeln(ofh, blacklosses)
  775.     call writeln(ofh, '')
  776.     call writeln(ofh, 'White losses:')
  777.     call writeln(ofh, whitelosses)
  778.     call writeln(ofh, '')
  779.     call writeln(ofh, 'K = King      B = Bishop     C = Castle')
  780.     call writeln(ofh, 'Q = Queen     N = Knight     P = Pawn')
  781.  
  782.     call close(ofh)
  783. RETURN
  784.  
  785. PostMsg:
  786.     address(bbsread)
  787.     UNIQUEMSGFILE bbsname '"'MSG.BBSNAME'"' stem UNIQUEFILE
  788.     if(rc ~= 0) then
  789.     do
  790.         address(thorport)
  791.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  792.         signal exit
  793.     end
  794.  
  795.     address command 'copy >nil: T:ChessMaster3000.thor.temp TO ' || UNIQUEFILE.NAME
  796.     EVENT.MSGFILE = UNIQUEFILE.FILEPART
  797.  
  798.     address(bbsread)
  799.     WRITEBREVENT bbsname '"'MSG.BBSNAME'"' event EVENT.TYPE stem EVENT
  800.     if(rc ~= 0) then
  801.     do
  802.         address(thorport)
  803.         REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
  804.         signal exit
  805.     end
  806.  
  807.     address(thorport)
  808.     REQUESTNOTIFY TEXT '"Edit message?"' BT '"_Yes|_No"'
  809.     if(result = 1) then STARTEDITOR FILE '"'UNIQUEFILE.NAME'"'
  810. RETURN
  811.  
  812. signal exit:
  813.     address command 'delete T:ChessMaster3000.thor.temp quiet'
  814.     exit
  815.